perm filename 11FTP.MAC[11,HE] blob
sn#554604 filedate 1981-01-01 generic text, type T, neo UTF8
.TITLE File Transfer Program
.MCALL ALUN$S,GLUN$S,QIOW$S,EXIT$S,GREG$S
.MCALL FDBDF$,FDAT$A,FDRC$A,FDBK$A,FDOP$A,FINIT$,FSRSZ$
.MCALL OPEN$R,OPEN$W,CLOSE$,READ$,WRITE$
.MCALL WAIT$
;need mcall for pausing 1/60 sec or thereabouts
;?? what if file exactly fits last block? what are values for F.EFBK & F.FFBY??
.BLKW 100 ;Make some stack space
SPSTRT:
REGBUF: .BLKW 3 ;To stick region info into
RDSTS: .WORD 0 ;Read status block
RDCNT: .WORD 0
TTYBUF: .BLKB 80. ;For reading commands
WRSTS: .WORD 0,0 ;Write status block
STATBF: .BYTE TC.SCP ;Ask if CRT
CRTP: .BYTE 0
IOSTAT: .WORD 0,0 ;Status for disk ops
NUMBUF: .BLKB 12.
BUFPTR: .WORD 0
FILDON: .WORD 0 ;Contains first free byte address for last buffer
COM: .WORD 0
FDB: FDBDF$ ;Make up the disk header info
; FDAT$A R.FIX,,512.,-120.
; FDRC$A FD.RWM
; FDBK$A BUFFER,512.,,2,IOSTAT
; FDOP$A 2,DATSET
FSRSZ$ 1
DBUF: .BLKW 256. ;Disk block buffer
DATSET:
DEVCNT: .WORD 0
DEVNAM: .WORD 0
UICCNT: .WORD 0
UICNAM: .WORD 0
FILCNT: .WORD 0
FILNAM: .WORD 0
DEV: .ASCII / /
OKMES: .ASCII /OK/
OKSIZ = .-OKMES
BADDEV: .ASCII /NO SUCH DEVICE/
BDEVSZ = .-BADDEV
BADFIL: .ASCII /CAN'T OPEN FILE/
BFILSZ = .-BADFIL
.EVEN
START: MOV #SPSTRT,SP ;Set up stack???
ALUN$S #1,#"TI,#0 ;LUN 1 is TI: device
BCC 1$
IOT ;Punt if error
1$: QIOW$S #IO.ATT,#1,#1 ;Attach it
BCC 2$
IOT ;Punt if error
2$: GREG$S ,#REGBUF ;Get region base address
BCC 3$
IOT
3$: MOV REGBUF,R1
JSR PC,OUTNUM ;Print it out
MOV #BUFPTR,R1 ;Give local address of buffer pointer
JSR PC,OUTNUM ;Print it out
FINIT$
BCC CLOOP
IOT
CLOOP: CLR BUFPTR
CLR FILDON
CLR DEVCNT ;Re-initialize Data set descriptor
CLR UICCNT
CLR FILCNT
MOV #TTYBUF,R1
MOV #40,R0
1$: CLR (R1)+ ;Zero command line buffer
SOB R0,1$
2$: QIOW$S #IO.RLB,#1,#1,,#RDSTS,,<#TTYBUF,#80.> ;Get a command line
BCC 3$
IOT ;Punt if error
3$: MOV #TTYBUF,R1
4$: CMPB (R1),#12 ;Skip over linefeeds
BNE 5$
INC R1
DEC RDCNT ;Update read count
BPL 4$
CLR RDCNT
5$: CMPB (R1),#105 ;All done? Command = "E"
BNE 6$ ; No - go execute command
EXIT$S ERROR ; Yes - Go away
6$: MOV RDCNT,R4 ;See how many characters were typed
BEQ 2$ ;Ignore null lines
SUB #2,R4 ;Don't care about command
MOVB (R1)+,COM ;Save command
INC R1 ;Point to start of file spec
CMPB (R1),#133 ;UIC?
BEQ UICPAR ;Go parse UIC, no device given
CMPB 1(R1),#72 ;See if we have a device
BEQ DEVPAR
CMPB 2(R1),#72
BEQ DEVPAR
CMPB 3(R1),#72
BEQ DEVPAR
BR FILPAR ;No device or UIC given - get filename
DEVPAR: MOV R1,DEVNAM ;Point data set at device name
MOVB (R1)+,DEV ;Store first char of device name
CLRB DEV+1 ;In case no second char
CLR R3 ;Unit # of device (default = 0)
1$: INC DEVCNT
CMPB (R1),#72 ;Scan til ":"
BEQ 3$ ; Done
CMPB (R1),#101 ;Alpha?
BMI 2$ ; No - < "A"
MOVB (R1)+,DEV+1 ;Store second char of device name
BR 1$
2$: MOVB (R1)+,R3 ;Get Unit # in R3
SUB #60,R3 ;Convert ASCII to # (-"0")
BR 1$
3$: INC R1
INC DEVCNT
SUB DEVCNT,R4 ;Update char count
ALUN$S #2,DEV,R3 ;LUN 2 is device
BCC UICPAR
QIOW$S #IO.WLB,#1,#1,,#WRSTS,,<#BADDEV,#BDEVSZ,#40> ;Abort if bad dev
BCC 4$
IOT ;Punt if error
4$: JMP CLOOP ;Try again
UICPAR: CMPB (R1),#133 ;UIC? (="[")
BNE FILPAR ;Go parse filename, no UIC given
MOV R1,UICNAM ;Point to start of UIC
1$: INC UICCNT
CMPB (R1)+,#135 ;Scan to closing "]"
BNE 1$
SUB UICCNT,R4 ;Update count of characters left
FILPAR: MOV R1,FILNAM ;Point to start of filename
MOV R4,FILCNT ; & Store its length
CMPB COM,#123 ;See what we're supposed to do
BEQ RDFILE ;"S" - Go read in an old file
JMP WTFILE ;"G" - Go write out a new file
RDFILE: OPEN$R #FDB,#2,#DATSET,#FD.RWM,#DBUF,#512.,FILERR
QIOW$S #IO.WLB,#1,#1,,#WRSTS,,<#OKMES,#OKSIZ,#40> ;Tell 10 all's well
BCC 1$
IOT ;Punt if error
1$: MOV FDB+F.EFBK+2,R4 ;R4 has count of blocks in file
RLOOP: READ$ #FDB,,,,,,,RWERR ;Read in next block
WAIT$ #FDB,,,RWERR
TSTB IOSTAT ;Did it succeed?
BPL 1$ ; Yes
JMP RWERR ; No - punt
1$: DEC R4 ;One less block to read
BGT 2$ ;Was this the last block?
MOV F.FFBY(R0),FILDON ; Yes - tell 10 this is the end
2$: MOV #DBUF,BUFPTR ;Give buffer to 10
3$: ;?? ;Wait a bit
TST BUFPTR ;Has 10 finished with it yet?
BNE 3$ ; No - keep waiting
TST R4 ;More to send?
BGT RLOOP ; Yup - go read next block
JMP DONE ; No - go close file & get next command
WTFILE: OPEN$W #FDB,#2,#DATSET,#FD.RWM,#DBUF,#512.,FILERR
QIOW$S #IO.WLB,#1,#1,,#WRSTS,,<#OKMES,#OKSIZ,#40> ;Tell 10 all's well
BCC 1$
IOT ;Punt if error
1$: CLR R4 ;Keep a count of # of blocks we write
WLOOP: MOV #DBUF,BUFPTR ;Tell 10 where to stick block
1$: ;?? ;Wait a bit
TST BUFPTR ;Has 10 finished with it yet?
BNE 1$ ; No - keep waiting
WRITE$ #FDB,,,,,,,RWERR ;Write out next block
WAIT$ #FDB,,,RWERR
TSTB IOSTAT ;Did it succeed?
BMI RWERR ; No - punt
INC R4 ;Update block count
TST FILDON ;Was this last block?
BEQ WLOOP ; No - get next block
; Yes - fix up FDB
MOVB #2,F.RTYP+FDB ;Say we're really a variable length file
MOVB #2,F.RATT+FDB ;Say to print a cr after each record
MOV #130.,F.RSIZ+FDB ;Biggest record should be less than this
MOV R4,F.EFBK+2+FDB ;Tell how many blocks we are
MOV FILDON,F.FFBY+FDB ;Tell where the last record ends
;Now we can close the file
DONE: CLOSE$ #FDB,ERROR ;All done with file now
CLR BUFPTR
JMP CLOOP ;Get next command
FILERR: QIOW$S #IO.WLB,#1,#1,,#WRSTS,,<#BADFIL,#BFILSZ,#40> ;Abort if bad file
BCC 1$
IOT ;Punt if error
1$: JMP CLOOP ;Try again
RWERR: MOV #1,BUFPTR ;Abort if read/write error
JMP CLOOP ;Try again
ERROR: IOT ;Punt if error
;Auxiliary routine to print out the octal number in R1
OUTNUM: MOV R0,-(SP) ;We need some free registers
MOV R1,-(SP)
MOV R2,-(SP)
MOV R3,-(SP)
MOV #NUMBUF,R2 ;Where we'll stick the result
CLR R0
MOV #6,R3 ;6 digits to print
ASHC #1,R0 ;Get high order digit
1$: TST R0 ;Don't print leading zeros
BNE 2$ ;Found highest order non-zero digit
ASHC #3,R0 ;Try next
SOB R3,1$
INC R3
2$: ADD #60,R0 ;Convert to ASCII
MOVB R0,(R2)+ ;Stick it in buffer
CLR R0
ASHC #3,R0 ;Move on to next digit
SOB R3,2$ ;Do them all
SUB #NUMBUF,R2 ;Get character count for writing
QIOW$S #IO.WLB,#1,#1,,#WRSTS,,<#NUMBUF,R2,#40> ;Type it out
BCS ERROR ;Punt if error
MOV (SP)+,R3 ;Restore registers
MOV (SP)+,R2
MOV (SP)+,R1
MOV (SP)+,R0
RTS PC
.END START